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-- ListSymbols.mesa; modified by Johnsson, July 20, 1978 1:42 PM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
BcdDefs: FROM "bcddefs", 
CommanderDef s : FROM "commanderdef s" , 
IODefs: FROM "iodefs", 
ListerDefs: FROM "1 isterdef s" , 
LitDefs: FROM "litdefs", 
OutputDefs: FROM "outputdef s" , 
SegmentDefs: FROM "segmentdefs", 
StringDefs: FROM "stringdef s" , 
SymbolTableDefs: FROM "symbol tabledef s" , 
SymDefs: FROM "symdefs", 
SymSegDefs: FROM "symsegdef s" , 
SymTabDefs: FROM "symtabdef s" , 
TableDefs: FROM "tabledefs", 
TreeDefs: FROM "treedefs"; 

DEFINITIONS FROM ListerDefs, OutputDefs, SymDefs; 

ListSymbols: PROGRAM IMPORTS CommanderDef s , IODefs, ListerDefs, LitDefs, OutputDefs, SegmentDefs, Strin 
**gDefs, SymbolTableDefs, SymSegDefs, TableDefs, TreeDefs 

EXPORTS ListerDefs * 

BEGIN 

FileSegmentHandle: TYPE ■ SegmentDefs. FileSegmentHandle; 

CR: CHARACTER = IODefs. CR; 

symbol s : Symb o 1 Tab 1 eDe fs. Symbol Tab leB as e; 

-- utilities 

seb, ctxb, htb, ltb, tb: TableDefs .TableBase; 

ListSymbolsNotify : TableDefs. TableNotif ier ■ 
BEGIN 

tb <- base[TreeDef s . treetype]; 
ltb +- base[LitDefs.lttype]; 
seb *- base[SymDef s . setype]; 
ctxb <- base[SymDef s . ctxtype] ; 
htb <- base[SymDef s .httype]; 
END; 

-- tree printing 

PrintLiteral : PROCEDURE[t: literal TreeDefs. TreeLink] « 
BEGIN OPEN LitDefs; 
desc: LitDescriptor; 
i: CARDINAL; 
v: WORD; 

WITH t.info SELECT FROM 
string => 

BEGIN PutChar[ ,M ]; 

PutString[StringLiteralValue[index]]; 
PutChar[ ,M ]; 

IF index # MasterString[index] THEN PutChar['L]; 
END; 
word => 
BEGIN 

desc «- LitDescriptorValue[index]; 
IF desc. length # 1 THEN PutChar['[]; 
FOR i IN [0 . . desc. length) 
DO 

IF (v «- (ltb+desc.offset)[i]) < 1000 
THEN PutDecimal[v] 
ELSE PutOctal[v]; 
IF i+l # desc. length THEN PutChar[',]; 
ENDLOOP; 
IF desc. length # 1 THEN PutChar[ ' ]] ; 
END; 
ENDCASE; 
END; 

PrintSubTree: PROCEDURE [t: TreeDefs .TreeLink , nBlanks: CARDINAL] - 
BEGIN OPEN TreeDefs; 
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Printer: TreeMap ■ 
BEGIN 

node: Treelndex; 
Indent[nBlanks]; 
WITH s: t SELECT FROM 

hash a > PrintHti[s . index]; 
symbol ■> PrintSei[s. index]; 
literal a > PrintLiteral[s] ; 
subtree ■> 

BEGIN node <- s. index; 
SELECT node FROM 

nullTreelndex a > PutString["<empty>"] ; 
ENDCASE »> 

BEGIN OPEN (tb+node); 

PutNodeName[name] ; 

PutChar['[]; PrintIndex[node]; PutString["] "]; 

IF info # 

THEN BEGIN PutString[" 1nfo- M ]; PrintIndex[info] END; 
IF attrl OR attr2 
THEN 
BEGIN 

IF info = THEN PutChar[' ]; 
PutChar['(]; 

IF attrl THEN PutChar['l]; 
IF attr2 THEN PutChar['2]; 
PutChar[')]; 
END; 
nBlanks «- nBlanks + 2; 
[] <- TreeDefs.UpdateTree[s, Printer]; 
nBlanks ♦- nBlanks - 2; 
END; 
END; 
ENDCASE; 
RETURN [t] 
END; 

[] *- Printer[t]; RETURN 
END; 

PrintTree: PUBLIC PROCEDURE [t: TreeDef s .TreeLink] » 
BEGIN 

PrintSubTree[t, 0]; PutChar[CR]; 
END; 

PrintBodies: PUBLIC PROCEDURE » 
BEGIN OPEN symbols; 
bti, prev: BTIndex; 
bti <- FIRST[BTIndex]; 
DO 

PrintBody[bti]; 
IF (bb+bti).firstSon # BTNull 
THEN bti <- (bb+bti).firstSon 
ELSE 
DO 

prev <- bti; bti <- (bb+bti ). 1 ink . index; 
IF bti « BTNull THEN GO TO Done; 
IF (bb+prev). link. which # parent THEN EXIT; 
ENDLOOP; 
REPEAT 

Done -> NULL; 
ENDLOOP; 
PutChar[CR]; 
END; 

PrintBody: PROCEDURE [bti: BTIndex] ■ 
BEGIN 

OPEN body: (symbol s . bb+bti ) ; 

PutChar[CR]; PutChar[CR]; PutString["Body["]; 
Printlndex[bti]; PutString[ H ] : "]; 
WITH b: body SELECT FROM 
Callable «> 

BEGIN 

PrintSei[b.id]; 

PutString[", ep: "]; PutDecimal[b .entrylndex]; 

WITH b SELECT FROM 
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Inner ■> 
BEGIN 

PutString['\ frame address: "]; PutDecimal [frameOff set] ; 
END; 
ENDCASE; 
END; 
ENDCASE «> PutString["(anon)"]; 
PutChar[CR]; 

PutString[" context: "]; PrintIndex[body. localCtx]; 
PutString['\ static level: "]; PutDecimal[body .level] ; 
WITH body. info SELECT FROM 
External ■> 
BEGIN 

PutString[", Origin: "]; PrintIndex[origin] ; 
PutString[", Bytes: "]; PutDecimal[bytes]; 
PutString[", startlndex: "]; PutDecimal [startlndex] ; 
PutString[", indexLength: "]; PutDecimal [indexLength] ; 
END; 
ENDCASE; 
PutChar[CR]; RETURN 
END; 

PrintType: PROCEDURE [sei: SEIndex] * 
BEGIN 

tSei: SEIndex; 
IF sei = SENull 

THEN PutString["?"] 
ELSE 

WITH t: (symbols. seb+sei) SELECT FROM 
constructor »> 

WITH t SELECT FROM 

transfer => PutModeName[mode] ; 
ENDCASE => PutTypeName[t.typetag]; 
id *> 
BEGIN 

PrintSei[LOOPHOLE[sei, ISEIndex]]; tSei <- sei; 
UNTIL (tSei <- symbol s.TypeLink[tSei]) = SENull 
DO 

WITH (seb+tSei) SELECT FROM 
id => 

BEGIN PutChar[' ]; PrintSei[LOOPHOLE[tSei , ISEIndex]]; 
END; 
ENDCASE; 
ENDLOOP; 
END; 
ENDCASE; 
PutString[" ["]; Printlndex[sei] ; PutChar[']]; 
RETURN 
END; 

PrintTypelnfo: PROCEDURE [sei: SEIndex, nBlanks: CARDINAL] » 
BEGIN 

IF sei // SENull 
THEN 

WITH s: (symbols. seb+sei) SELECT FROM 
constructor »> 

BEGIN Indent[nBlanks]; 

PutChar['[]; Printlndex[sei] ; PutString["] "]; 

WITH s SELECT FROM 

transfer => PutModeName[mode] ; 
ENDCASE »> PutTypeName[s.typetag]; 
WITH t: s SELECT FROM 
basic s > 
BEGIN 

IF t. ordered THEN PutString[" (ordered)"]; 
PutString[", code: "]; 
PutDecimal[t .code] ; 

PutString[", length: "]; PutOctal [t . length]; 
END; 
enumerated a > 
BEGIN 

IF t. ordered THEN PutString[" (ordered)"]; 
PutString[", value ctx: "]; 
Printlndex[t,valuectx]; 
PutString[", nvalues: "]; 
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PutDecimal [t.nvalues]; 

END; 
record ■> 

BEGIN 

IF -t.lengthtlsed THEN PutChar['*]; 

IF t.machineDep THEN PutString[" (md)"]; 

IF t. monitored THEN PutString[" (monitored)"]; 

IF t. variant THEN PutString[" (variant)"]; 

OutRecordCtx[", field ctx: ", L00PH0LE[sei , recordCSEIndex]] ; 

WITH (ctxb+t.fieldctx) SELECT FROM 
included ■ > 

IF -ctxcomplete THEN PutString[" [partial]"]; 
imported ■> PutString[" [partial]"]; 
ENDCASE; 

WITH t SELECT FROM 
linked => 

BEGIN PutString['\ link: "]; 
PrintType[l ink type] ; 
END; 
ENDCASE; 

END; 
pointer a > 

BEGIN 

IF ~t. dereferenced THEN PutChar['*]; 

IF t. ordered THEN PutString[" (ordered)"]; 

IF t. readonly THEN PutString[" (readonly)"]; 

IF t. basing THEN PutString[" (base)"]; 

PutString[", pointing to: "]; 

PrintType[t .pointed to type] ; 

PrintTypeInfo[t . pointed to type, nBlanks+2]; 

END; 
array -> 

BEGIN 

IF -t.lengthUsed THEN PutChar['*]; 

IF t. packed THEN PutString[" (packed)"]; 

PutString[", index type: "]; PrintTypeft. indextype] ; 

PutString[", component type: "]; PrintType[t . componenttype] ; 

PrintTypeInfo[t. index type, nBlanks+2]; 

PrintTypeInfo[t . componenttype, nBlanks+2] ; 

END; 
arraydesc a > 

BEGIN 

PutString[", described type: "]; PrintType[t. describedType]; 

PrintTypeInfo[t.describedType, nBlanks+2]; 

END; 
transfer => 

BEGIN 

OutRecordCtx[" , input ctx: ", t.inrecord]; 

OutRecordCtx[" , output ctx: ", t.outrecord]; 

END; 
definition -> 

BEGIN 

PutString[", ctx: "]; Printlndexft . defCtx] ; 

PutString[", ngfi: "]; PutDecimal[ t .nGf i]; 

END; 
union *> 

BEGIN 

IF t.overlayed THEN PutString[" (overlayed)"] ; 

IF t. controlled THEN 

BEGIN PutString[\ tag: "]; PrintSei[t . tagsei] END; 

PutString[", tag type: "]; 

PrintType[(seb+t . tagsei) . id type]; 

PutString[ M , case ctx: "]; Printlndex[t. casectx] ; 

IF t. controlled 

THEN PrintSE[t. tagsei, nBlanks+2]; 

END; 
relative «> 

BEGIN 

PutString[", base type: "]; PrintType[t. baseType] ; 

PutString[", offset type: "]; Prin tType[t .of f setType] ; 

PutString[ M , result type: "]; PrintType[t . resul tType] ; 

Pr intType I nfo[t .baseType, nBlanks+2]; 

PrintTypeInfo[t .offset Type, nBlanks+2]; 

Pr i n tType Info[t . resul tType, nBlanks+2] ; 

END; 
subrange «> 
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BEGIN 

PutString[" of: "]; PrintType[t . rangetype] ; 
IF t. empty THEN PutString[" (empty) "]; 
IF t. filled 
THEN 
BEGIN 

PutString[" origin: "]; PutDecimal [t. origin] ; 
PutString[ M , range: "]; 
IF t. flexible 
THEN PutChar[ f *] 
ELSE PutDecimal[t. range]; 
END; 
Pr i ntType I nfo[t. rangetype, nBlanks+2]; 
END; 
long, real ■> 
BEGIN 

PutString[" of: "]; PrintType[t. rangetype]; 
PrintTypeInfo[t. rangetype, nBlanks+2]; 
END; 
ENDCASE; 
END; 
ENDCASE; 
RETURN 
END; 

OutRecordCtx: PROCEDURE [message: STRING, sei: recordCSEIndex] ■ 
BEGIN 

PutSt ring [mess age] ; 
IF sei « SENull 

THEN PutString["NIL"] 

ELSE Printlndex[(seb+sei) .f ieldctx]; 
RETURN 
END; 

Printlndex: PROCEDURE [v: UNSPECIFIED] = LOOPHOLE[PutDecimal ]; 

PrintSymbols: PROCEDURE = 
BEGIN 

ctx: CTXIndex; 
ctx <- FIRST[CTXIndex]; 

UNTIL ctx - LOOPHOLE[symbols.stHandle.ctxBlock.size, CTXIndex] DO 
PutCR[]; PrintContext[ctx]; 

ctx «~ ctx + (WITH (symbols. ctxb+ctx) SELECT FROM 
included »> SIZE [included CTXRecord], 
imported => SIZE [imported CTXRecord], 
ENDCASE => SIZE [simple CTXRecord]); 
ENDLOOP; 
PutCR; 

IF ~ symbol s. stHandle. def initionsFile THEN PrintBodies[] ; 
RETURN 
END; 

PrintContext: PROCEDURE [ctx: CTXIndex] - 
BEGIN 

sei, root: ISEIndex; 
PutCR; 

PutString["Context: "]; Printlndex[ctx] ; 
IF (symbols. ctxb+ctx) .ctxlevel # 1Z THEN 
BEGIN PutString[ M , static level: "]; 
PutDecimal [(symbol s. ctxb+ctx) .ctxlevel ]; 
END; 
WITH (symbols. ctxb+ctx) SELECT FROM 
included => 

BEGIN PutStn'ng[" t copied from [file: "]; 
PrintHti[( symbols . mdb+c txmodule) . mdh ti] ; 
PutString[", context: "]; Pr intlndex[ctxmap] ; 
PutCharf']]; 
END; 
imported «> 

BEGIN PutString[ M , imported from file: "]; 

PrintHti[( symbol s .mdb+-( symbol s . ctxb + includeLink) . c txmodule) .mdhti]; 
END; 
ENDCASE; 
root <- sei <- ( symbols .ctxb + ctx) . sei ist; 
WHILE sei // SENull DO 
PrintSE[sei, 2]; 
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IF (sei <- symbols. NextSe[sei]) - root THEN EXIT; 

ENDLOOP; 
RETURN 
END; 

PrintSE: PROCEDURE [sei: ISEIndex, nBlanks: CARDINAL] - 
BEGIN OPEN (seb+sei); 
typeSei: SEIndex; 
addr: BitAddress; 
link: BcdDef s .ControlLink; 
Indent[nBlanks]; 
PrintSe i[sei]; 

PutString[" ["]; Printlndex[sei] ; PutChar[']]; 
IF public THEN PutString[" [public]"]; 
IF mark3 THEN 
BEGIN 

PutString[", type a "]; 
IF idtype ■ typeTYPE THEN 
BEGIN typeSei <- idinfo; 
PutString["TYPE, equated to: "]; 
PrintType[ typeSei] ; 
IF symbols. Typel_ink[sei] # SENull THEN 

BEGIN PutString[", tag code: "]; PutDecimal [idvalue] END; 
END 
ELSE 

BEGIN typeSei «- idtype; PrintType[typeSei] ; 
SELECT TRUE FROM 

constant *> PutString[" [const]"]; 
writeonce => PutString[" [init only]"]; 
ENDCASE; 
IF ~mark4 THEN 

BEGIN PutString[", # refs: "]; PutDecimal [idinfo] END 
ELSE 

SELECT TRUE FROM 
constant s > 

IF ~ extended THEN 

BEGIN PutString[", value: "]; 
SELECT symbols. XferMode[typeSei] FROM 
procedure, program, signal, error => 
BEGIN link <- idvalue; 
PutChar['[]; 

PutDecimal [1 ink. gf i]; PutChar[ f ,]; 
PutDecimalflink.ep]; PutChar[' , ]; 
PutDecimal [LOOPHOLE[ link. tag]]; PutChar[']]; 
END; 
ENDCASE => 

IF LOOPHOLE[idvalue, CARDINAL] < 1000 
THEN PutDecimal [idvalue] 
ELSE PutOctal[idvalue]; 
END; 
(symbols. stHandle. def initionsFile AND (ctxb+ctxnum) . ctxlevel ■ 1G) => 

BEGIN PutString[", index: "]; PutDecimal [idvalue] END; 
ENDCASE => 

BEGIN addr <- idvalue; 
PutString[ M , address: "]; 
PutDecimal[addr.wd]; PutChar[' ]; 
PutChar['[]; PutDecimal [addr .bd]; 
PutChar[' :]; PutDecimal [id info] ; 
PutChar[']]; 

IF linkSpace THEN PutChar[' *]; 
END; 
END; 
PrintTypeInfo[typeSei , nBlanks+2]; 

IF extended THEN PrintSubTree[SymSegDef s . FindExtension[sei] , nBlanks+4]; 
END; 
RETURN 
END; 

TypePrintName: ARRAY TypeClass OF STRING - [ 

"mode", "basic", "enumerated", "record", "pointer", "array", 

"arraydesc", "transfer", "definition", "union", "relative", "subrange", "long", "real", "nil"]; 

PutTypeName: PROCEDURE[n: TypeClass] ■ 
BEGIN 

PutString[TypePrintName[n]]; RETURN 
END; 
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ModePrintName: ARRAY Transf erMocle OF STRING - [ 

"procedure", "port", "signal", "error", "process", "program", "none"]; 

PutModeName: PROCEDURE[n: TransferMode] - 
BEGIN 

PutString[ModePrintName[n]]; RETURN 
END; 

symbol sin: BOOLEAN 4- FALSE; 

GetSymbolTable: PROCEDURE [seg: FileSegmentHandle] ■ 
BEGIN 

IF symbolsln THEN TableDef s .DropNotify[ListSymbolsNotify] ; 
symbol s+-Symbol Tab! eDefs .AcquireSymbolTable[ 

Symbol Tab leDef s .Table For Segment [ seg]]; 
Lister Defs .SetRoutineSymbol s[symbols]; 
TableDefs.AddNotify[ListSymbolsNotify]; 
TreeDefs.TreeInit[]; 
LitDefs.LitTabInit[]; 
symbolsln <- TRUE; 
END; 

Symbols: PROCEDURE[root : STRING] = 
BEGIN OPEN StringDefs; 
i: CARDINAL; 
bcdFile: STRING <- [40]; 
sseg: FileSegmentHandle; 
AppendString[bcdFile,root]; 
FOR i IN [0. .bcdFile. length) DO 

IF bcdFile[i] ■ ' . THEN EXIT; 

REPEAT FINISHED => AppendStr ing[bcdF i 1 e , " . bed"] ; 

ENDLOOP; 
BEGIN 
[symbols: sseg] <- Load[bcdFile I NoCode => RESUME; 

NoFGT => RESUME; 

NoSymbols, IncorrectVersion , Mul tipleModu les a > 

BEGIN IODefs.WriteString["Bad format"]; GOTO giveup END; 

SegmentDef s .FileNameError ■> 

BEGIN IODefs.WriteString["File not found"]; GOTO giveup END]; 
GetSymbol Tab! e[ sseg]; 
OpenOutput[root," .si"]; 
WriteFileID[]; 
PrintSymbol s[]; 
CloseOutput[] ; 
EXITS giveup => NULL; 
END; 
END; 

SymbolSegment: PROCEDURE [ 

root: STRING, base: Al toDef s . PageNumber , pages: Al toDef s .PageCount] ■» 

BEGIN OPEN StringDefs; 

i: CARDINAL; 

bcdFile: STRING <- [40]; 

sseg: FileSegmentHandle; 

AppendString[bcdFile,root]; 

FOR i IN [0. .bcdFile. length) DO 

IF bcdFile[i] ■ ' . THEN EXIT; 

REPEAT FINISHED => AppendStr ing[bcdF il e, ". bed"] ; 

ENDLOOP; 
BEGIN OPEN SegmentDefs; 

sseg <- NewFileSegment[ 

NewFile[bcdFile, Read, Def aul tVersion t 

FileNameError *> GO TO NoFile], 
base, pages, Read i 

Inval idSegmentSize «> GO TO BadSegment]; 

GetSymbolTable[sseg]; 

OpenOutput[root , " . si "]; 

PutString["Symbol Table in File: "]; 

PutString[root]; 

PutString[", base: "]; 

PutDecimal [base]; 

PutString[", pages: "]; 

PutDecimal [pages] ; 

PutCR[]; 

Wri teVers ions [©symbol s . stHan die. version , ©symbol s.stHandle. creator]; 
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PrintSymbols[]; 

C'loseOutput[]; 

EXITS 

NoFile «> IODefs.WriteString["File not found"]; 

BadSegment a > IODef s .WriteString["Bad Segment"]; 
END; 
END; 

command: CommanderDef s.CommandBlockHandle; 

command «- CommanderDef s. AddCommand[ "Symbols" , LOOPHOLE [Symbols] , 1] ; 
command. params[0] <- [type: string, prompt: "Filename"]; 

command «- CommanderDef s .AddCommand[ "Symbol Segment" .LOOPHOLE [Symbol Segment] ,3]; 
command. params[0] <- [type: string, prompt: "Filename"]; 
command. params[l] <- [type: numeric, prompt: "Base"]; 
command. params[2] <- [type: numeric, prompt: "Pages"]; 

END... 



